home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / pcl4p40.zip / AMODEM.PAS next >
Pascal/Delphi Source File  |  1993-04-25  |  10KB  |  332 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*       --- ASCII Protocol ---              *)
  4. (*                                           *)
  5. (*  This program is donated to the Public    *)
  6. (*  Domain by MarshallSoft Computing, Inc.   *)
  7. (*  It is provided as an example of the use  *)
  8. (*  of the Personal Communications Library.  *)
  9. (*                                           *)
  10. (*********************************************)
  11.  
  12. { $DEFINE DEBUG}
  13. {$I DEFINES.PAS}
  14.  
  15. unit amodem;
  16.  
  17. interface
  18.  
  19. uses term_io,PCL4P,crt,xypacket;
  20.  
  21. (* reference 'xypacket' to get BufferType definition *)
  22.  
  23. function TxAscii(
  24.          Port     : Integer;     (* COM port [0..3] *)
  25.      Var Filename : String20;    (* filename buffer *)
  26.      Var Buffer   : BufferType;  (* 1024 buffer *)
  27.          CharPace : Integer;     (* millisecond delay between characters *)
  28.          TermChar : Byte;        (* termination character ($00 => none) *)
  29.          TimeOut  : Integer;     (* delay after which assume sender is dome *)
  30.          EchoFlag : Boolean)     (* local echo flag *)
  31.          : Boolean;
  32.  
  33. function RxAscii(
  34.          Port     : Integer;     (* COM port [0..3] *)
  35.      Var Filename : String20;    (* filename buffer *)
  36.      Var Buffer   : BufferType;  (* 1024 buffer *)
  37.          RxBufSize: Integer;     (* size of RX receive buffer *)
  38.          TermChar : Byte;        (* termination character ($00 => none) *)
  39.          TimeOut  : Integer;     (* delay after which assume sender is dome *)
  40.          EchoFlag : Boolean)     (* local echo flag *)
  41.          : Boolean;
  42.  
  43. implementation
  44.  
  45. Const
  46.      XON  = $11;
  47.      XOFF = $13;
  48.      CAN  = $18;
  49.      ONE_SECOND  = 18;
  50.  
  51. Var  (* globals *)
  52.      LastXchar : Byte;          (* last XON or XOFF *)
  53.      LastTime  : LongInt;       (* last time character was received *)
  54.      DataCount : Integer;       (* # bytes in Buffer *)
  55.  
  56. procedure ReportBytes(Bytes : LongInt);
  57. var
  58.   Message : String[50];
  59. begin
  60.   Str(Bytes,Message);
  61.   Message := 'Ascii: ' + Message + ' bytes.';
  62.   WriteMsg(Message,1);
  63. end;
  64.  
  65. function UserQuits(Port : Integer) : Boolean;
  66. var
  67.   UserChar : Char;
  68.   Code     : Integer;
  69. begin
  70.   (* does user want to quit ? *)
  71.   UserQuits := FALSE;
  72.   if KeyPressed then
  73.     begin
  74.       UserChar := ReadKey;
  75.       if Ord(UserChar) = CAN then
  76.         begin
  77.           TxCAN(Port);
  78.           Code := SioPutc(Port,chr($03));
  79.           WriteMsg('Ascii: Aborted by USER...',1);
  80.           UserQuits := TRUE
  81.         end
  82.       else Code := SioPutc(Port,UserChar);
  83.     end
  84. end;
  85.  
  86. function CheckForXOFF(Port:Integer) : Boolean;
  87. Var
  88.   Code : Integer;
  89. begin
  90.   (* check for incoming XOFF *)
  91.   Code := GetChar(Port,0);
  92.   if Code = XOFF then
  93.     begin
  94.       (* received a XOFF *)
  95.       WriteMsg('Ascii: XOFF received',1);
  96.       LastXchar := XOFF;
  97.       CheckForXOFF := TRUE;
  98.     end
  99.   else CheckForXOFF := FALSE
  100. end;
  101.  
  102. function WaitForXON(Port:Integer;TimeOut:Integer) : Boolean;
  103. Var
  104.   Code : Integer;
  105.   ExitFlag : Boolean;
  106. begin
  107.   LastTime := SioTimer;
  108.   ExitFlag := FALSE;
  109.   repeat
  110.     Code := GetChar(Port,ONE_SECOND);
  111.     if Code = -1 then
  112.       begin
  113.         (* nothing there *)
  114.         if SioTimer-LastTime > 60*ONE_SECOND then
  115.           begin
  116.             (* we have timed out *)
  117.             WriteMsg('Ascii: Timed out waiting for XON',1);
  118.             WaitForXON := FALSE;
  119.             ExitFlag := TRUE;
  120.           end
  121.       end
  122.     else
  123.       (* character received *)
  124.       begin
  125.         if Code = XON then
  126.           begin
  127.             (* received character was XON *)
  128.             WriteMsg('Ascii: XON received',1);
  129.             LastXchar := XON;
  130.             WaitForXON := TRUE;
  131.             ExitFlag := TRUE;
  132.           end
  133.         else
  134.           begin
  135.             (* received character wasn't a XON *)
  136.             WriteMsg('Ascii: Received character not XON',1);
  137.           end
  138.       end
  139.   until ExitFlag;
  140. end;
  141.  
  142. procedure CheckQueue(Port,LoMark,HiMark:Integer);
  143. var
  144.   QueueSize : Integer;
  145. begin
  146.   QueueSize := SioRxQue(Port);
  147.   if (QueueSize>HiMark) and (LastXchar=XON) then
  148.     begin
  149.       PutChar(Port,XOFF);
  150.       LastXchar := XOFF;
  151.       WriteMsg('Ascii: Sending XOFF',1)
  152.     end;
  153.   if (QueueSize<LoMark) and (LastXchar=XOFF) then
  154.     begin
  155.       PutChar(Port,XON);
  156.       LastXchar := XON;
  157.       WriteMsg('Ascii: Sending XON',1)
  158.     end
  159. end;
  160.  
  161. function TxAscii(
  162.          Port     : Integer;     (* COM port [0..3] *)
  163.      Var Filename : String20;    (* filename buffer *)
  164.      Var Buffer   : BufferType;  (* 1024 buffer *)
  165.          CharPace : Integer;     (* millisecond delay between characters *)
  166.          TermChar : Byte;        (* termination character ($00 => none) *)
  167.          TimeOut  : Integer;     (* delay after which assume sender is done *)
  168.          EchoFlag : Boolean)     (* local echo flag *)
  169.          : Boolean;
  170. Label 999;
  171. Var
  172.   i      : Integer;
  173.   Code   : Integer;
  174.   Handle : File;
  175.   c      : Char;
  176.   TheByte   : Byte;
  177.   BytesRead : Integer;
  178.   ExitFlag  : Boolean;
  179.   TxChars   : LongInt;
  180.   Message   : String[50];
  181. begin
  182. {$I-}
  183.   (* open the file *)
  184.   Assign(Handle,Filename);
  185.   Reset(Handle,1);
  186. {$I+}
  187.   if IOResult <> 0 then
  188.     begin
  189.       Message := 'Ascii: Cannot open ' + Filename;
  190.       WriteMsg(Message,1);
  191.       TxAscii := FALSE;
  192.       goto 999;
  193.     end;
  194.   (* start ascii send *)
  195.   WriteMsg('Ascii: Starting SEND',1);
  196.   LastXchar := XON;
  197.   ExitFlag := FALSE;
  198.   TxChars := 0;
  199.   (* flush keyboard & serial port *)
  200.   while KeyPressed do c := ReadKey;
  201.   Code := SioRxFlush(Port);
  202.   (* send ascii file *)
  203.   repeat
  204.     (* does user want to quit ? *)
  205.     if UserQuits(Port) then goto 999;
  206.     (* read next buffer from disk *)
  207.     BlockRead(Handle,Buffer,1024,BytesRead);
  208.     (* send 1 character at a time *)
  209.     for i := 0 to BytesRead-1 do
  210.       begin
  211.         (* send character & delay *)
  212.         TheByte := Buffer[i];
  213.         PutChar(Port,TheByte);
  214.         if EchoFlag then write(chr(TheByte));
  215.         if CharPace > 0 then Delay(CharPace);
  216.         if TheByte = $0d then Delay(250);
  217.         TxChars := TxChars + 1;
  218.         if (TxChars mod 100) = 0 then ReportBytes(TxChars);
  219.         (* check for incoming XOFF *)
  220.         if CheckForXOFF(Port) then
  221.           begin
  222.             (* received XOFF, so wait for XON *)
  223.             if not WaitForXON(Port,TimeOut) then ExitFlag := TRUE;
  224.           end
  225.       end;
  226.   until ExitFlag or (BytesRead = 0);
  227.   (* send termination character, if any *)
  228.   if TermChar <> $00 then
  229.     begin
  230.       PutChar(Port,TermChar);
  231.       WriteMsg('Ascii: Termination character sent',1);
  232.     end;
  233.   close(Handle);
  234. 999:end; (* TxAscii *)
  235.  
  236. function RxAscii(
  237.          Port     : Integer;     (* COM port [0..3] *)
  238.      Var Filename : String20;    (* filename buffer *)
  239.      Var Buffer   : BufferType;  (* 1024 buffer *)
  240.          RxBufSize: Integer;     (* receive buffer size *)
  241.          TermChar : Byte;        (* termination character ($00 => none) *)
  242.          TimeOut  : Integer;     (* delay after which assume sender is done *)
  243.          EchoFlag : Boolean)     (* local echo flag *)
  244.          : Boolean;
  245. Label 999;
  246. Var
  247.   c       : Char;
  248.   i, k    : Integer;
  249.   Handle  : File;         (* file Handle *)
  250.   Code    : Integer;      (* return code *)
  251.   Flag    : Boolean;
  252.   Message : String40;
  253.   Temp    : String40;
  254.   Result  : Integer;
  255.   LoMark   : Integer;     (* receive buffer low water mark *)
  256.   HiMark   : Integer;     (* receive buffer high water mark *)
  257.   ExitFlag : Boolean;
  258.   RxChars  : LongInt;
  259.   (* begin *)
  260. begin
  261. {$I-}
  262.   (* open the file for write *)
  263.   Assign(Handle,Filename);
  264.   Rewrite(Handle,1);
  265. {$I+}
  266.   if IOResult <> 0 then
  267.     begin
  268.       Message := 'Ascii: Cannot open ' + Filename;
  269.       WriteMsg(Message,1);
  270.       RxAscii := FALSE;
  271.       goto 999;
  272.     end;
  273.   (* flush keyboard & serial port *)
  274.   while KeyPressed do c := ReadKey;
  275.   Code := SioRxFlush(Port);
  276.   (* receive text *)
  277.   WriteMsg('Ascii: Starting RECEIVE',1);
  278.   LoMark := RxBufSize div 8;
  279.   HiMark := 5 * LoMark;
  280.   LastXchar := XON;
  281.   DataCount := 0;
  282.   RxChars := 0;
  283.   ExitFlag := FALSE;
  284.   repeat
  285.     (* does user want to quit ? *)
  286.     if UserQuits(Port) then goto 999;
  287.     (* check receive queue size *)
  288.     CheckQueue(Port,LoMark,HiMark);
  289.     (* get next character *)
  290.     if RxChars = 0 then
  291.       begin
  292.         (* wait 1 minute for 1st character *)
  293.         Code := GetChar(Port,60*ONE_SECOND);
  294.         LastTime := SioTimer
  295.       end
  296.     else Code := GetChar(Port,TimeOut*ONE_SECOND);
  297.     (* did we timeout ? *)
  298.     if Code = -1 then
  299.       begin
  300.         (* we have timed out ! *)
  301.         ExitFlag := TRUE;
  302.         WriteMsg('Ascii: Timeout.',1);
  303.       end;
  304.     (* termination character ? *)
  305.     if (Code <> -1) and (TermChar<>$00) and (Code=TermChar) then
  306.       begin
  307.         (* received termination character *)
  308.         ExitFlag := TRUE;
  309.         WriteMsg('Ascii: Termination character received',1);
  310.       end
  311.     else
  312.       begin
  313.         RxChars := RxChars + 1;
  314.         if EchoFlag then write(chr(Code));
  315.         if (RxChars mod 100) = 0 then ReportBytes(RxChars);
  316.         (* put character in buffer *)
  317.         Buffer[DataCount] := Code;
  318.         DataCount := DataCount + 1;
  319.         if DataCount = 1024 then
  320.           begin
  321.             BlockWrite(Handle,Buffer,DataCount);
  322.             DataCount := 0;
  323.           end
  324.       end
  325.   until ExitFlag;
  326.   (* flush the data buffer *)
  327.   if DataCount > 0 then BlockWrite(Handle,Buffer,DataCount);
  328.   (* close the output file *)
  329.   close(Handle);
  330. 999:end; (* end - RxAscii *)
  331.  
  332. end.